home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMM / VSSCM32 / MISC.PAS next >
Pascal/Delphi Source File  |  1996-02-26  |  3KB  |  113 lines
  1. unit Misc;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, SysUtils;
  7.  
  8. function FormatLastError( dwLastError: DWORD;
  9.      szOutputBuffer: PChar; dwSizeofOutputBuffer: DWORD ): PChar;
  10.  
  11. const
  12.     MAXOUTPUTSTRINGLENGTH = 4096;
  13.  
  14. implementation
  15.  
  16. function MAKELANGID( usPrimaryLanguage, usSubLanguage: Byte ): WORD;
  17. begin
  18.     Result := ((usSubLanguage shl 10) + usPrimaryLanguage);
  19. end;
  20.  
  21. //
  22. //  FUNCTION: FormatLastError(DWORD, LPSTR, DWORD)
  23. //
  24. //  PURPOSE: Pretty print a system error to a string.
  25. //
  26. //  PARAMETERS:
  27. //    dwLastError          - Actual error code to decipher.
  28. //    szOutputBuffer       - String buffer to pretty print to.
  29. //    dwSizeofOutputBuffer - Size of String buffer.
  30. //
  31. //  RETURN VALUE:
  32. //    Returns the buffer printed to.
  33. //
  34. //  COMMENTS:
  35. //    If szOutputBuffer isn't big enough to hold the whole string,
  36. //    then the string gets truncated to fit the buffer.
  37. //
  38. //    If szOutputBuffer == NULL, then dwSizeofOutputBuffer
  39. //    is ignored, a buffer 'big enough' is LocalAlloc()d and
  40. //    a pointer to it is returned.  However, its *very* important
  41. //    that this pointer be LocalFree()d by the calling application.
  42. //
  43. //
  44. function FormatLastError( dwLastError: DWORD;
  45.      szOutputBuffer: PChar; dwSizeofOutputBuffer: DWORD ): PChar;
  46. var
  47.     dwRetFM,
  48.     dwFlags:                     DWORD;
  49.     dwGetLastError:             DWORD;
  50.     szFormatMessageError:    LPSTR;
  51. begin
  52.     dwFlags := FORMAT_MESSAGE_FROM_SYSTEM;
  53.  
  54.      // Should we allocate a buffer?
  55.      if szOutputBuffer = nil then
  56.      begin
  57.           // Actually, we make FormatMessage allocate the buffer, if needed.
  58.           dwFlags := dwFlags + FORMAT_MESSAGE_ALLOCATE_BUFFER;
  59.  
  60.           // minimum size FormatMessage should allocate.
  61.           dwSizeofOutputBuffer := 1;
  62.      end;
  63.  
  64.      // Make FormatMessage pretty print the system error.
  65.      dwRetFM := FormatMessage(
  66.           dwFlags, nil, dwLastError,
  67.           MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US),
  68.           PAnsiChar(@szOutputBuffer), dwSizeofOutputBuffer,
  69.           nil);
  70.  
  71.      // FormatMessage failed to print the error.
  72.      if dwRetFM = 0 then
  73.      begin
  74.           dwGetLastError := GetLastError;
  75.  
  76.           // If we asked FormatMessage to allocate a buffer, then it
  77.           // might have allocated one.  Lets be safe and LocalFree it.
  78.           if (dwFlags and FORMAT_MESSAGE_ALLOCATE_BUFFER) <> 0 then
  79.           begin
  80.                 LocalFree(HLOCAL(szOutputBuffer));
  81.  
  82.                 szOutputBuffer := PChar(LocalAlloc( LPTR, MAXOUTPUTSTRINGLENGTH ));
  83. {                dwSizeofOutputBuffer := MAXOUTPUTSTRINGLENGTH;}
  84.  
  85.                 if szOutputBuffer = nil then
  86.                 begin
  87.                      OutputDebugString( 'Out of memory trying to FormatLastError' );
  88.                      result := nil;
  89.                      Exit;
  90.                 end;
  91.           end;
  92.  
  93.           szFormatMessageError := PChar(IntToStr(dwGetLastError));{
  94.                 FormatLastError( dwGetLastError, nil, 0 );}
  95.  
  96.           if szFormatMessageError = nil then
  97.           begin
  98.                 Result := nil;
  99.                 Exit;
  100.           end;
  101.  
  102.           wsprintf(szOutputBuffer,
  103.                 PChar('FormatMessage failed on error '+IntToStr(dwLastError)+' for the following reason: '+
  104.                     szFormatMessageError) );
  105.  
  106.           LocalFree( HLOCAL(szFormatMessageError) );
  107.      end;
  108.  
  109.      Result := szOutputBuffer;
  110. end;
  111.  
  112. end.
  113.